home *** CD-ROM | disk | FTP | other *** search
/ ADA Programming Guide / ADA Programming Guide.iso / ada_gnu / adainc / s-tasuti.adb < prev    next >
Text File  |  1996-01-30  |  25KB  |  768 lines

  1. ------------------------------------------------------------------------------
  2. --                                                                          --
  3. --                 GNU ADA RUNTIME LIBRARY (GNARL) COMPONENTS               --
  4. --                                                                          --
  5. --              S Y S T E M . T A S K I N G . U T I L I T I E S             --
  6. --                                                                          --
  7. --                                  B o d y                                 --
  8. --                                                                          --
  9. --                             $Revision: 1.9 $                             --
  10. --                                                                          --
  11. --       Copyright (c) 1991,1992,1993,1994, FSU, All Rights Reserved        --
  12. --                                                                          --
  13. -- GNARL is free software; you can redistribute it  and/or modify it  under --
  14. -- terms  of  the  GNU  Library General Public License  as published by the --
  15. -- Free Software  Foundation;  either version 2, or (at  your  option)  any --
  16. -- later  version.  GNARL is distributed  in the hope that  it will be use- --
  17. -- ful, but but WITHOUT ANY WARRANTY;  without even the implied warranty of --
  18. -- MERCHANTABILITY  or  FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Gen- --
  19. -- eral Library Public License  for more details.  You should have received --
  20. -- a  copy of the GNU Library General Public License along with GNARL;  see --
  21. -- file COPYING.LIB.  If not,  write to the  Free Software Foundation,  675 --
  22. -- Mass Ave, Cambridge, MA 02139, USA.                                      --
  23. --                                                                          --
  24. ------------------------------------------------------------------------------
  25.  
  26. --  This package provides RTS Internal Declarations.
  27. --  These declarations are not part of the GNARLI
  28.  
  29. with System.Task_Primitives;  use System.Task_Primitives;
  30.  
  31. with System.Compiler_Exceptions;
  32. --  Used for, Tasking_Error_ID
  33.  
  34. with System.Tasking.Abortion;
  35. --  Used for, Undefer_Abortion,
  36. --            Abort_To_Level
  37.  
  38. with System.Tasking.Queuing; use System.Tasking.Queuing;
  39. --  Used for, Queuing.Dequeue_Head
  40.  
  41. with System.Error_Reporting;
  42. --  Used for, Error_Reporting.Assert
  43.  
  44. package body System.Tasking.Utilities is
  45.  
  46.    ------------------
  47.    -- Make_Passive --
  48.    ------------------
  49.  
  50.    --  This is a local procedure
  51.  
  52.    procedure Make_Passive
  53.      (T : Utilities.ATCB_Ptr);
  54.    --  Record that task T is passive.
  55.  
  56.    ------------------------------------
  57.    -- Vulnerable_Complete_Activation --
  58.    ------------------------------------
  59.  
  60.    --  WARNING : Only call this procedure with abortion deferred.
  61.    --  That's why the name has "Vulnerable" in it.
  62.  
  63.    procedure Vulnerable_Complete_Activation
  64.      (T : ATCB_Ptr;
  65.       Completed : Boolean)
  66.    is
  67.       Activator : ATCB_Ptr;
  68.       Error     : Boolean;
  69.  
  70.    begin
  71.       Activator := T.Activator;
  72.  
  73.       if Activator /= null then
  74.       --  Should only be null for the environment task.
  75.  
  76.          --  Decrement the count of tasks to be activated by the
  77.          --  activator and wake it up so it can check to see if
  78.          --  all tasks have been activated.  Note that the locks
  79.          --  of the activator and created task are locked here.
  80.          --  This is necessary because C.Stage and
  81.          --  T.Activation_Count have to be synchronized.  This is
  82.          --  also done in Activate_Tasks and Init_Abortion.  So
  83.          --  long as the activator lock is always locked first,
  84.          --  this cannot lead to deadlock.
  85.  
  86.          Write_Lock (Activator.L, Error);
  87.          Write_Lock (T.L, Error);
  88.  
  89.          if T.Stage = Can_Activate then
  90.             T.Stage := Active;
  91.             Activator.Activation_Count := Activator.Activation_Count - 1;
  92.             Cond_Signal (Activator.Cond);
  93.             if Completed then
  94.                Activator.Exception_To_Raise :=
  95.                  Compiler_Exceptions.Tasking_Error_ID;
  96.             end if;
  97.          end if;
  98.          Unlock (T.L);
  99.          Unlock (Activator.L);
  100.  
  101.       end if;
  102.  
  103.    end Vulnerable_Complete_Activation;
  104.  
  105.    --  PO related routines
  106.  
  107.    ---------------------
  108.    -- Check_Exception --
  109.    ---------------------
  110.  
  111.    procedure Check_Exception is
  112.       T  : ATCB_Ptr := ID_To_ATCB (Self);
  113.       Ex : Compiler_Exceptions.Exception_ID := T.Exception_To_Raise;
  114.  
  115.    begin
  116.       T.Exception_To_Raise := Compiler_Exceptions.Null_Exception;
  117.       Compiler_Exceptions.Raise_Exception (Ex);
  118.    end Check_Exception;
  119.  
  120.    --  Rendezvous related routines
  121.  
  122.    -------------------
  123.    -- Close_Entries --
  124.    -------------------
  125.  
  126.    procedure Close_Entries (Target : Task_ID) is
  127.       T           : ATCB_Ptr := ID_To_ATCB (Target);
  128.       Temp_Call   : Entry_Call_Link;
  129.       Null_Call   : Entry_Call_Link := null;
  130.       Temp_Caller : ATCB_Ptr;
  131.       TAS_Result  : Boolean;
  132.       Error       : Boolean;
  133.  
  134.    begin
  135.       --  Purging pending callers that are in the middle of rendezvous
  136.  
  137.       Temp_Call := T.Call;
  138.  
  139.       while Temp_Call /= null loop
  140.          Temp_Call.Exception_To_Raise := Compiler_Exceptions.Tasking_Error_ID;
  141.  
  142.          Temp_Caller := ID_To_ATCB (Temp_Call.Self);
  143.  
  144.          --  Problem: Once this lock is unlocked, the target gan go on to
  145.          --  accept other calls, which will be missed by loop.  The question
  146.          --  is, is there something else that will prevent this???
  147.          --  If the target is in an abortion deferred region at this point,
  148.          --  I don't know what it would be.
  149.  
  150.          --  By the time we get here, we do know that the target is complete
  151.          --  and not callable.  Callable is unprotected, but Stage is protected
  152.          --  by T.L.  If all forms of accept made sure under the protection of
  153.          --  T.L that they were not complete before accepting a call, then it
  154.          --  should be safe to unlock this here.
  155.  
  156.          --  Problem: what about multiple aborters?  If two tasks are in this
  157.          --  routine at once, then there could contention if this mutex is
  158.          --  unlocked.  We need some other form of claim mechanism to prevent
  159.          --  this.  I think that the mechanism outlined in the implementation
  160.          --  sketch, where an aborter waits for a previous aborter to finish
  161.          --  its work, might solve this.
  162.  
  163.          --  What if T itself is at exactly this point and gets aborted?  In
  164.          --  that case, I think that the aborter has to wait for T to finish
  165.          --  completing itself.  This was previously done by contending for the
  166.          --  mutex; it might now have to be done with some kind of flag, or
  167.          --  maybe another stage.  Perhaps we are setting Stage=Complete too
  168.          --  soon, and abortion should wait on that.  That would require
  169.          --  some other flag to claim the right to complete, however.  This
  170.          --  flag could probably be protected by T.L; there should not be
  171.          --  any need for a TAS or global mutex.  Perhaps the Aborting flag
  172.          --  could do this, though right now all it means is that an abortion
  173.          --  exception has been sent.  We really need a separate Completing
  174.          --  flag (ugh).  On the bright side, this might mean that completion
  175.          --  can be treated as once-and-once-only, and need not be reentrant.
  176.  
  177.          --  Problem: What does an acceptor do when it finds that it is being
  178.          --  completed?  I guess it should wait until completion is finished,
  179.          --  just like a second aborter.  Otherwise, it might continue on
  180.          --  with a rendezvous that it never really accepted.
  181.  
  182.          Write_Lock (Temp_Caller.L, Error);
  183.          Temp_Call.Done := True;
  184.          Unlock (Temp_Caller.L);
  185.  
  186.          --  The caller can break out of its loop at this point, and never
  187.          --  notice the abortion.
  188.  
  189. --       Temp_Call.Call_Claimed:= False;
  190. --  Wrong, I think.  This should look like a completed call to everyone. ???
  191.  
  192.          Abort_To_Level (ATCB_To_ID (Temp_Caller), Temp_Call.Level - 1);
  193.  
  194.          --  I think this might be wrong; Abortion takes precedence over
  195.          --  exceptions in the call block. ???
  196.          --  Not true; the last call to be canceled won't raise Abortion again;
  197.          --  it raises the chosen exception instead.  This is true of leaf
  198.          --  (suspending) calls as well; they decrement the nesting level
  199.          --  before undeferring abortion, which will prevent further abortion
  200.          --  (providing that abortion is not to an outer level).
  201.          --  Final resolution and removal of these comments, or replacement
  202.          --  by comments saying what is happening without speculation
  203.          --  is needed (RBKD) ???
  204.  
  205.          Temp_Call := Temp_Call.Acceptor_Prev_Call;
  206.       end loop;
  207.  
  208.       --  Purging entry queues
  209.  
  210.       for J in 1 .. T.Entry_Num loop
  211.          Dequeue_Head (T.Entry_Queues (J), Temp_Call);
  212.  
  213.          if Temp_Call /= Null_Call then
  214.             loop
  215.                Test_And_Set (Temp_Call.Call_Claimed'Address, TAS_Result);
  216.  
  217.                if TAS_Result then
  218.                   Temp_Caller := ID_To_ATCB (Temp_Call.Self);
  219.                   Temp_Call.Exception_To_Raise :=
  220.                     Compiler_Exceptions.Tasking_Error_ID;
  221.                   Temp_Call.Done := True;
  222.  
  223.                   Abort_To_Level (
  224.                     ATCB_To_ID (Temp_Caller), Temp_Call.Level - 1);
  225.  
  226.                else
  227.                   null;
  228.  
  229.                   --  Someone else claimed this call.  It must be to cancel it,
  230.                   --  since the acceptor can't have accepted it at this point.
  231.                   --  So far as we are concerned, this call is not on the
  232.                   --  queue, and we don't have to raise tasking error in the
  233.                   --  caller.
  234.                end if;
  235.  
  236.                Dequeue_Head (T.Entry_Queues (J), Temp_Call);
  237.                exit when Temp_Call = Null_Call;
  238.             end loop;
  239.          end if;
  240.       end loop;
  241.  
  242.    end Close_Entries;
  243.  
  244.    ----------------------------
  245.    -- Complete_On_Sync_Point --
  246.    ----------------------------
  247.  
  248.    procedure Complete_on_Sync_Point (T : Task_ID) is
  249.       Target     : ATCB_Ptr := ID_To_ATCB (T);
  250.       Call       : Entry_Call_Link;
  251.       TAS_Result : Boolean;
  252.       Error      : Boolean;
  253.  
  254.    begin
  255.       Write_Lock (Target.L, Error);
  256.  
  257.       if Target.Suspended_Abortably then
  258.  
  259.          if Target.Accepting /= Not_Accepting then
  260.             Unlock (Target.L);
  261.             Complete (T);
  262.  
  263.          else
  264.             --  Hopefully suspended on an entry call by elimination.
  265.  
  266.             if Target.ATC_Nesting_Level > ATC_Level_Base'First then
  267.                Call := Target.Entry_Calls (Target.ATC_Nesting_Level)'Access;
  268.                Test_And_Set (Call.Call_Claimed'Address, TAS_Result);
  269.  
  270.                if TAS_Result then
  271.                   Unlock (Target.L);
  272.                   Complete (T);
  273.                   Call.Call_Claimed := False;
  274.  
  275.                   --  To allow abortion to claim it.
  276.  
  277.                else
  278.                   Unlock (Target.L);
  279.                end if;
  280.             end if;
  281.          end if;
  282.  
  283.       else
  284.          Unlock (Target.L);
  285.       end if;
  286.    end Complete_on_Sync_Point;
  287.  
  288.    --------------------
  289.    -- Reset_Priority --
  290.    --------------------
  291.  
  292.    procedure Reset_Priority
  293.      (Acceptor_Prev_Priority : Rendezvous_Priority;
  294.        Acceptor              : Task_ID)
  295.    is
  296.       Acceptor_ATCB : ATCB_Ptr := ID_To_ATCB (Acceptor);
  297.  
  298.    begin
  299.       if Acceptor_Prev_Priority /= Priority_Not_Boosted then
  300.          Acceptor_ATCB.Current_Priority := Acceptor_Prev_Priority;
  301.          Set_Priority
  302.            (Acceptor_ATCB.LL_TCB'Access, Acceptor_ATCB.Current_Priority);
  303.       end if;
  304.    end Reset_Priority;
  305.  
  306.    ---------------------------
  307.    -- Terminate_Alternative --
  308.    ---------------------------
  309.  
  310.    --  WARNING : Only call this procedure with abortion deferred. This
  311.    --  procedure needs to have abortion deferred while it has the current
  312.    --  task's lock locked. Since it is called from two procedures which
  313.    --  also need abortion deferred, it is left controlled on entry to
  314.    --  this procedure.
  315.  
  316.    procedure Terminate_Alternative is
  317.       P, T  : ATCB_Ptr := ID_To_ATCB (Self);
  318.       Taken : Boolean;
  319.       Error : Boolean;
  320.  
  321.    begin
  322.       Make_Passive (T);
  323.  
  324.       --  Note that abortion is deferred here (see WARNING above)
  325.  
  326.       Write_Lock (T.L, Error);
  327.  
  328.       T.Terminate_Alternative := true;
  329.  
  330.       while T.Accepting /= Not_Accepting
  331.         and then T.Stage /= Complete
  332.         and then T.Pending_ATC_Level >= T.ATC_Nesting_Level
  333.       loop
  334.          Cond_Wait (T.Cond, T.L);
  335.       end loop;
  336.  
  337.       if T.Stage = Complete then
  338.          Unlock (T.L);
  339.  
  340.          if T.Pending_ATC_Level < T.ATC_Nesting_Level then
  341.             Abortion.Undefer_Abortion;
  342.             Error_Reporting.Assert (False, "Continuing after being aborted!");
  343.          end if;
  344.  
  345.          Abort_To_Level (ATCB_To_ID (T), 0);
  346.          Abortion.Undefer_Abortion;
  347.          Error_Reporting.Assert (False, "Continuing after being aborted!");
  348.       end if;
  349.  
  350.       T.Terminate_Alternative := false;
  351.  
  352.       Unlock (T.L);
  353.  
  354.    end Terminate_Alternative;
  355.  
  356.    --------------
  357.    -- Complete --
  358.    --------------
  359.  
  360.    procedure Complete (Target : Task_ID) is
  361.       T      : ATCB_Ptr := ID_To_ATCB (Target);
  362.       Caller : ATCB_Ptr := ID_To_ATCB (Self);
  363.       Task1  : ATCB_Ptr;
  364.       Task2  : ATCB_Ptr;
  365.       Error  : Boolean;
  366.  
  367.    begin
  368.       --  Make_Passive used to be the last thing done in this routine in the
  369.       --  original MRTSI code.  Make_Passive was modified not to process a
  370.       --  completed task, so setting the complete flag conflicted with this.
  371.       --  I don't see any reason why the task cannot be made passive before
  372.       --  it is marked as completed, but I may find out. ???
  373.  
  374.       Make_Passive (T);
  375.       Write_Lock (T.L, Error);
  376.  
  377.       if T.Stage < Completing then
  378.          T.Stage := Completing;
  379.          T.Accepting := Not_Accepting;
  380.  
  381.          --  *LATER* consider new value of this type  ???
  382.  
  383.          T.Awaited_Dependent_Count := 0;
  384.          Unlock (T.L);
  385.          Close_Entries (ATCB_To_ID (T));
  386.          T.Stage := Complete;
  387.  
  388.          --  Wake up all the pending calls on Aborter_Link list
  389.  
  390.          Task1 := T.Aborter_Link;
  391.          T.Aborter_Link := null;
  392.  
  393.          while (Task1 /= null) loop
  394.             Task2 := Task1;
  395.             Task1 := Task1.Aborter_Link;
  396.             Task2.Aborter_Link := null;
  397.             Cond_Signal (Task2.Cond);
  398.          end loop;
  399.  
  400.       else
  401.          --  Some other task is completing this task. So just wait until
  402.          --  the completion is done. A list of such waiting tasks is
  403.          --  maintained by Aborter_Link in ATCB.
  404.  
  405.          while T.Stage < Complete loop
  406.             if T.Aborter_Link /= null then
  407.                Caller.Aborter_Link := T.Aborter_Link;
  408.             end if;
  409.  
  410.             T.Aborter_Link := Caller;
  411.             Cond_Wait (Caller.Cond, T.L);
  412.          end loop;
  413.  
  414.          Unlock (T.L);
  415.       end if;
  416.    end Complete;
  417.  
  418.    --  Task_Stage related routines
  419.  
  420.    ----------------------
  421.    -- Make_Independent --
  422.    ----------------------
  423.  
  424.    procedure Make_Independent is
  425.       T : ATCB_Ptr := ID_To_ATCB (Self);
  426.       P : ATCB_Ptr;
  427.       Result : Boolean;
  428.       Error  : Boolean;
  429.    begin
  430.       Write_Lock (T.L, Error);
  431.       P := T.Parent;
  432.       Unlock (T.L);
  433.  
  434.       Write_Lock (P.L, Error);
  435.       Write_Lock (T.L, Error);
  436.  
  437.       T.Master_of_Task := Master_ID (0);
  438.  
  439.       if P.Awake_Count > 1 then
  440.          P.Awake_Count := P.Awake_Count - 1;
  441.       end if;
  442.  
  443.       Unlock (T.L);
  444.       Unlock (P.L);
  445.  
  446.       Remove_From_All_Tasks_List (T, Result);
  447.       Error_Reporting.Assert (Result,
  448.          "Failed to delete an entry from All_Tasks_List");
  449.  
  450.    end Make_Independent;
  451.  
  452.    --  Task Abortion related routines
  453.  
  454.    --------------------
  455.    -- Abort_To_Level --
  456.    --------------------
  457.  
  458.    procedure Abort_To_Level
  459.      (Target : Task_ID;
  460.       L      : ATC_Level)
  461.    is
  462.       T      : ATCB_Ptr := ID_To_ATCB (Target);
  463.       Error  : Boolean;
  464.  
  465.    begin
  466.       Write_Lock (T.L, Error);
  467.  
  468.       if T.Pending_ATC_Level > L then
  469.          T.Pending_ATC_Level := L;
  470.          T.Pending_Action := True;
  471.  
  472.          if not T.Aborting then
  473.             T.Aborting := True;
  474.  
  475.             if T.Suspended_Abortably then
  476.                Cond_Signal (T.Cond);
  477.                Cond_Signal (T.Rend_Cond);
  478.  
  479.                --  Ugly; think about ways to have tasks suspend on one
  480.                --  condition variable. ???
  481.  
  482.             else
  483.  
  484.                if Target =  Self then
  485.                   Unlock (T.L);
  486.                   Abort_Task (T.LL_TCB'Access);
  487.                   return;
  488.  
  489.                elsif T.Stage /= Terminated then
  490.                   Abort_Task (T.LL_TCB'Access);
  491.                end if;
  492.  
  493.                --  If this task is aborting itself, it should unlock itself
  494.                --  before calling abort, as it is unlikely to have the
  495.                --  opportunity to do so afterwords. On the other hand, if
  496.                --  another task is being aborted, we want to make sure it is
  497.                --  not terminated, since there is no need to abort a terminated
  498.                --  task, and it may be illegal if it has stopped executing.
  499.                --  In this case, the Abort_Task must take place under the
  500.                --  protection of the mutex, so we know that Stage/=Terminated.
  501.  
  502.             end if;
  503.          end if;
  504.       end if;
  505.  
  506.       Unlock (T.L);
  507.  
  508.    end Abort_To_Level;
  509.  
  510.    -------------------
  511.    -- Abort_Handler --
  512.    -------------------
  513.  
  514.    procedure Abort_Handler
  515.      (Context : Task_Primitives.Pre_Call_State)
  516.    is
  517.       T : ATCB_Ptr := ID_To_ATCB (Self);
  518.  
  519.    begin
  520.       if T.Deferral_Level = 0
  521.         and then T.Pending_ATC_Level < T.ATC_Nesting_Level
  522.       then
  523.          raise Standard'Abort_Signal;
  524.  
  525.          --  Not a good idea; signal remains masked after the Abortion ???
  526.          --  exception is handled.  There are a number of solutions :
  527.          --  1. Change the PC to point to code that raises the exception and
  528.          --     then jumps to the location that was interrupted.
  529.          --  2. Longjump to the code that raises the exception.
  530.          --  3. Unmask the signal in the Abortion exception handler
  531.          --     (in the RTS).
  532.       end if;
  533.    end Abort_Handler;
  534.  
  535.    ----------------------
  536.    -- Abort_Dependents --
  537.    ----------------------
  538.  
  539.    --  Process abortion of child tasks.
  540.  
  541.    --  Abortion should be dererred when calling this routine.
  542.    --  No mutexes should be locked when calling this routine.
  543.  
  544.    procedure Abort_Dependents (Abortee : Task_ID) is
  545.       Temp_T                : ATCB_Ptr;
  546.       Temp_P                : ATCB_Ptr;
  547.       Old_Pending_ATC_Level : ATC_Level_Base;
  548.       TAS_Result            : Boolean;
  549.       A                     : ATCB_Ptr := ID_To_ATCB (Abortee);
  550.       Error                 : Boolean;
  551.  
  552.    begin
  553.       Write_Lock (All_Tasks_L, Error);
  554.       Temp_T := All_Tasks_List;
  555.  
  556.       while Temp_T /= null loop
  557.          Temp_P := Temp_T.Parent;
  558.  
  559.          while Temp_P /= null loop
  560.             exit when Temp_P = A;
  561.             Temp_P := Temp_P.Parent;
  562.          end loop;
  563.  
  564.          if Temp_P = A then
  565.             Temp_T.Accepting := Not_Accepting;
  566.  
  567.             --  Send cancel signal.
  568.             Complete_on_Sync_Point (ATCB_To_ID (Temp_T));
  569.             Abort_To_Level (ATCB_To_ID (Temp_T), 0);
  570.          end if;
  571.  
  572.          Temp_T := Temp_T.All_Tasks_Link;
  573.       end loop;
  574.  
  575.       Unlock (All_Tasks_L);
  576.  
  577.    end Abort_Dependents;
  578.  
  579.    ------------------
  580.    -- Make_Passive --
  581.    ------------------
  582.  
  583.    --  If T is the last dependent of some master in task P to become passive,
  584.    --  then release P. A special case of this is when T has no dependents
  585.    --  and is completed. In this case, T itself should be released.
  586.  
  587.    --  If the parent is made passive, this is repeated recursively, with C
  588.    --  being the previous parent and P being the next parent up.
  589.  
  590.    --  Note that we have to hold the locks of both P and C (locked in that
  591.    --  order) so that the Awake_Count of C and the Awaited_Dependent_Count of
  592.    --  P will be synchronized.  Otherwise, an attempt by P to terminate can
  593.    --  preempt this routine after C's Awake_Count has been decremented to zero
  594.    --  but before C has checked the Awaited_Dependent_Count of P.  P would not
  595.    --  count C in its Awaited_Dependent_Count since it is not awake, but it
  596.    --  might count other awake dependents.  When C gained control again, it
  597.    --  would decrement P's Awaited_Dependent_Count to indicate that it is
  598.    --  passive, even though it was never counted as active.  This would cause
  599.    --  P to wake up before all of its dependents are passive.
  600.  
  601.    --  Note : Any task with an interrupt entry should never become passive.
  602.    --  Support for this feature needs to be added here.
  603.  
  604.    procedure Make_Passive (T : Utilities.ATCB_Ptr) is
  605.       P : Utilities.ATCB_Ptr;
  606.       --  Task whose Awaited_Dependent_Count may be decremented.
  607.  
  608.       C : Utilities.ATCB_Ptr;
  609.       --  Task whose awake-count gets decremented.
  610.  
  611.       H : Utilities.ATCB_Ptr;
  612.       --  Highest task that is ready to terminate dependents.
  613.  
  614.       Taken     : Boolean;
  615.       Activator : Utilities.ATCB_Ptr;
  616.       Error     : Boolean;
  617.  
  618.    begin
  619.       Utilities.Vulnerable_Complete_Activation (T, Completed => False);
  620.  
  621.       Write_Lock (T.L, Error);
  622.  
  623.       if T.Stage >= Utilities.Passive then
  624.          Unlock (T.L);
  625.          return;
  626.       else
  627.          T.Stage := Utilities.Passive;
  628.          Unlock (T.L);
  629.       end if;
  630.  
  631.       H := null;
  632.       P := T.Parent;
  633.       C := T;
  634.  
  635.       while C /= null loop
  636.  
  637.          if P /= null then
  638.             Write_Lock (P.L, Error);
  639.             Write_Lock (C.L, Error);
  640.  
  641.             C.Awake_Count := C.Awake_Count - 1;
  642.  
  643.             if C.Awake_Count /= 0 then
  644.  
  645.                --  C is not passive; we cannot make anything above this point
  646.                --  passive.
  647.  
  648.                Unlock (C.L);
  649.                Unlock (P.L);
  650.                exit;
  651.             end if;
  652.  
  653.             if P.Awaited_Dependent_Count /= 0 then
  654.  
  655.                --  We have hit a non-task master; we will not be able to make
  656.                --  anything above this point passive.
  657.  
  658.                P.Awake_Count := P.Awake_Count - 1;
  659.  
  660.                if C.Master_of_Task = P.Master_Within then
  661.                   P.Awaited_Dependent_Count := P.Awaited_Dependent_Count - 1;
  662.  
  663.                   if P.Awaited_Dependent_Count = 0 then
  664.                      H := P;
  665.                   end if;
  666.                end if;
  667.  
  668.                Unlock (C.L);
  669.                Unlock (P.L);
  670.                exit;
  671.             end if;
  672.  
  673.             if C.Stage = Utilities.Complete then
  674.  
  675.                --  C is both passive (Awake_Count = 0) and complete; wake it
  676.                --  up to await termination of its dependents.  It will not be
  677.                --  complete if it is waiting on a terminate alternative. Such
  678.                --  a task is not ready to wait for its dependents to terminate,
  679.                --  though one of its ancestors may be.
  680.  
  681.                H := C;
  682.             end if;
  683.  
  684.             Unlock (C.L);
  685.             Unlock (P.L);
  686.             C := P;
  687.             P := C.Parent;
  688.  
  689.          else
  690.             Write_Lock (C.L, Error);
  691.             C.Awake_Count := C.Awake_Count - 1;
  692.  
  693.             if C.Awake_Count /= 0 then
  694.  
  695.                --  C is not passive; we cannot make anything above
  696.                --  this point passive.
  697.  
  698.                Unlock (C.L);
  699.                exit;
  700.             end if;
  701.  
  702.             if C.Stage = Utilities.Complete then
  703.  
  704.                --  C is both passive (Awake_Count = 0) and complete; wake it
  705.                --  up to await termination of its dependents.  It will not be
  706.                --  complete if it is waiting on a terminate alternative. Such
  707.                --  a task is not ready to wait for its dependents to terminate,
  708.                --  though one of its ancestors may be.
  709.  
  710.                H := C;
  711.             end if;
  712.  
  713.             Unlock (C.L);
  714.             C := P;
  715.          end if;
  716.  
  717.       end loop;
  718.  
  719.       if H /= null then
  720.          Cond_Signal (H.Cond);
  721.       end if;
  722.  
  723.    end Make_Passive;
  724.  
  725.  
  726.    procedure Remove_From_All_Tasks_List (
  727.       Source : Utilities.ATCB_Ptr;
  728.       Result : out Boolean) is
  729.  
  730.       C        : Utilities.ATCB_Ptr;
  731.       P        : Utilities.ATCB_Ptr;
  732.       Previous : Utilities.ATCB_Ptr;
  733.       Error    : Boolean;
  734.    begin
  735.  
  736.       Write_Lock (Utilities.All_Tasks_L, Error);
  737.  
  738.       Result := False;
  739.  
  740.       Previous := null;
  741.       C := Utilities.All_Tasks_List;
  742.  
  743.       while C /= null loop
  744.          if C = Source then
  745.             Result := True;
  746.  
  747.             if Previous = null then
  748.                Utilities.All_Tasks_List :=
  749.                  Utilities.All_Tasks_List.All_Tasks_Link;
  750.             else
  751.                Previous.All_Tasks_Link := C.All_Tasks_Link;
  752.             end if;
  753.  
  754.             exit;
  755.  
  756.          end if;
  757.  
  758.          Previous := C;
  759.          C := C.All_Tasks_Link;
  760.  
  761.       end loop;
  762.  
  763.       Unlock (Utilities.All_Tasks_L);
  764.  
  765.    end Remove_From_All_Tasks_List;
  766.  
  767. end System.Tasking.Utilities;
  768.